Ted Talk

Some of the questions that can be answered with this dataset: 1. How is each TED Talk related to every other TED Talk? 2. Which are the most viewed and most favorited Talks of all time? Are they mostly the same? What does this tell us? 3. What kind of topics attract the maximum discussion and debate (in the form of comments)? 4. Which months are most popular among TED and TEDx chapters? 5. Which themes are most popular amongst TEDsters?

Read the data files

library(readr)
ted <- read_csv("ted-talks/ted_main.csv")

Parsed with column specification:
cols(
  comments = col_integer(),
  description = col_character(),
  duration = col_integer(),
  event = col_character(),
  film_date = col_integer(),
  languages = col_integer(),
  main_speaker = col_character(),
  name = col_character(),
  num_speaker = col_integer(),
  published_date = col_integer(),
  ratings = col_character(),
  related_talks = col_character(),
  speaker_occupation = col_character(),
  tags = col_character(),
  title = col_character(),
  url = col_character(),
  views = col_integer()
)

head(ted)

transcript <- read_csv("ted-talks/transcripts.csv")

Parsed with column specification:
cols(
  transcript = col_character(),
  url = col_character()
)

head(transcript)

See the information of both datasets

summary(ted)

    comments      description           duration         event             film_date           languages    
 Min.   :   2.0   Length:2550        Min.   : 135.0   Length:2550        Min.   :7.465e+07   Min.   : 0.00  
 1st Qu.:  63.0   Class :character   1st Qu.: 577.0   Class :character   1st Qu.:1.257e+09   1st Qu.:23.00  
 Median : 118.0   Mode  :character   Median : 848.0   Mode  :character   Median :1.333e+09   Median :28.00  
 Mean   : 191.6                      Mean   : 826.5                      Mean   :1.322e+09   Mean   :27.33  
 3rd Qu.: 221.8                      3rd Qu.:1046.8                      3rd Qu.:1.413e+09   3rd Qu.:33.00  
 Max.   :6404.0                      Max.   :5256.0                      Max.   :1.504e+09   Max.   :72.00  
 main_speaker           name            num_speaker    published_date        ratings          related_talks     
 Length:2550        Length:2550        Min.   :1.000   Min.   :1.151e+09   Length:2550        Length:2550       
 Class :character   Class :character   1st Qu.:1.000   1st Qu.:1.268e+09   Class :character   Class :character  
 Mode  :character   Mode  :character   Median :1.000   Median :1.341e+09   Mode  :character   Mode  :character  
                                       Mean   :1.028   Mean   :1.344e+09                                        
                                       3rd Qu.:1.000   3rd Qu.:1.423e+09                                        
                                       Max.   :5.000   Max.   :1.506e+09                                        
 speaker_occupation     tags              title               url                views         
 Length:2550        Length:2550        Length:2550        Length:2550        Min.   :   50443  
 Class :character   Class :character   Class :character   Class :character   1st Qu.:  755793  
 Mode  :character   Mode  :character   Mode  :character   Mode  :character   Median : 1124524  
                                                                             Mean   : 1698297  
                                                                             3rd Qu.: 1700760  
                                                                             Max.   :47227110  

summary(transcript)

  transcript            url           
 Length:2467        Length:2467       
 Class :character   Class :character  
 Mode  :character   Mode  :character  

Check the dimensions of the data

dim(ted)

[1] 2550   17

dim(transcript)

[1] 2467    2

Features Available - name: The official name of the TED Talk. Includes the title and the speaker. - title: The title of the talk - description: A blurb of what the talk is about. - main_speaker: The first named speaker of the talk. - speaker_occupation: The occupation of the main speaker. - num_speaker: The number of speakers in the talk. - duration: The duration of the talk in seconds. - event: The TED/TEDx event where the talk took place. - film_date: The Unix timestamp of the filming. - published_date: The Unix timestamp for the publication of the talk on TED.com - comments: The number of first level comments made on the talk. - tags: The themes associated with the talk. - languages: The number of languages in which the talk is available. - ratings: A stringified dictionary of the various ratings given to the talk (inspiring, fascinating, jaw dropping, etc.) - related_talks: A list of dictionaries of recommended talks to watch next. - url: The URL of the talk. - views: The number of views on the talk. I’m just going to reorder the columns in the order I’ve listed the features for my convenience (and OCD).

Let’s change the UNIX timestamps to human readable date

library(anytime)
ted$film_date <- anydate(ted$film_date)
ted$published_date <- anydate(ted$published_date)

Exploratory Data Analysis - Which talks are most and least viewed?

Which talks are most and least viewed?

library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

ten_talks <- arrange(ted, views)
keeps <- c("title", "main_speaker", "views", "speaker_occupation", "film_date")
ten_talks <- subset(ten_talks, select = c("title", "main_speaker", "views", "speaker_occupation", "film_date"))
last_10_talks <- ten_talks[0:10,]
last_10_talks

ten_talks <- arrange(ted, desc(views))
ten_talks <- subset(ten_talks, select = c("title", "main_speaker", "views", "speaker_occupation", "film_date"))
top_10_talks <- ten_talks[0:10,]
top_10_talks

Observations Ken Robinson’s talk on Do Schools Kill Creativity? is the most popular TED Talk of all time with 47.2 million views. Also coincidentally, it is also one of the first talks to ever be uploaded on the TED Site (the main dataset is sorted by published date). Robinson’s talk is closely followed by Amy Cuddy’s talk on Your Body Language May Shape Who You Are. There are only 2 talks that have surpassed the 40 million mark and 4 talks that have crossed the 30 million mark. Let us make a bar chart to visualise these 15 talks in terms of the number of views they garnered.

Loading required package: lattice
Loading required package: plyr
--------------------------------------------------------------------------------------------------------------------
You have loaded plyr after dplyr - this is likely to cause problems.
If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
library(plyr); library(dplyr)
--------------------------------------------------------------------------------------------------------------------

Attaching package: 'plyr'

The following objects are masked from 'package:dplyr':

    arrange, count, desc, failwith, id, mutate, rename, summarise, summarize

Distribution of Views

ted_small <- subset(ted, views < 0.4e7)
p3 <- ggplot(ted, aes(x=views)) + 
 geom_histogram(aes(y=..density..), colour="black", fill="white")+
 geom_density(alpha=.2, fill="#FF6666")
p4 <- ggplot(ted_small, aes(x=views)) +
  geom_histogram(aes(y=..density..), colour="black", fill="white")+
  geom_density(alpha=.2, fill="#FF6666")
multiplot(p3, p4, cols=2)

library(Hmisc)

Loading required package: survival
Loading required package: Formula

Attaching package: 'Hmisc'

The following objects are masked from 'package:plyr':

    is.discrete, summarize

The following objects are masked from 'package:dplyr':

    src, summarize

The following objects are masked from 'package:base':

    format.pval, units

describe(ted$views)

ted$views 
       n  missing distinct     Info     Mean      Gmd      .05      .10      .25      .50      .75      .90      .95 
    2550        0     2550        1  1698297  1562903   361142   484265   755793  1124524  1700760  3051913  4557041 

lowest :    50443    66668    82488   112321   115346, highest: 22270883 31168150 34309432 43155405 47227110

The average number of views on TED Talks in 1.6 million. and the median number of views is 1.12 million. This suggests a very high average level of popularity of TED Talks. We also notice that the majority of talks have views less than 4 million.

Comments Let’s analyze comments on the talks

describe(ted$comments)

ted$comments 
       n  missing distinct     Info     Mean      Gmd      .05      .10      .25      .50      .75      .90      .95 
    2550        0      559        1    191.6    197.6     24.0     35.9     63.0    118.0    221.8    393.1    586.1 

lowest :    2    3    5    6    7, highest: 2673 2877 3356 4553 6404

sd(ted$comments)

[1] 282.3152

Observations - On average, there are 191.5 comments on every TED Talk. Assuming the comments are constructive criticism, we can conclude that the TED Online Community is highly involved in discussions revolving TED Talks. - There is a huge standard deviation associated with the comments. In fact, it is even larger than the mean suggesting that the measures may be sensitive to outliers. We shall plot this to check the nature of the distribution. - The minimum number of comments on a talk is 2 and the maximum is 6404. The range is 6402.. The minimum number, though, may be as a result of the talk being posted extremely recently.

ted_small <- subset(ted, comments < 500)
p5 <- ggplot(ted, aes(x=comments)) + 
 geom_histogram(aes(y=..density..), colour="black", fill="white")+
 geom_density(alpha=.2, fill="#FF6666")
p6 <- ggplot(ted_small, aes(x=comments)) +
  geom_histogram(aes(y=..density..), colour="black", fill="white")+
  geom_density(alpha=.2, fill="#FF6666")
multiplot(p5, p6, cols=2)

From the plot above, we can see that the bulk of the talks have fewer than 500 comments. This clearly suggests that the mean obtained above has been heavily influenced by outliers. This is possible because the number of samples is only 2550 talks.

Another question that I am interested in is if the number of views is correlated with the number of comments. We should think that this is the case as more popular videos tend to have more comments. Let us find out.

scatter1 <- qplot(views,comments, data=ted)  + 
         scale_x_continuous(limits=c(min(ted$views),max(ted$views))) + 
         scale_y_continuous(limits=c(min(ted$comments),max(ted$comments))) + 
         geom_rug(col=rgb(.5,0,0,alpha=.2))
scatter1

vc_cor <- cor(ted$views, ted$comments)
print("Correlation between Views and Comments")

[1] "Correlation between Views and Comments"

vc_cor

[1] 0.5309387

As the scatterplot and the correlation matrix show, the pearson coefficient is slightly more than 0.5. This suggests a medium to strong correlation between the two quantities. This result was pretty expected as mentioned above. Let us now check the number of views and comments on the 10 most commented TED Talks of all time.

ten_talks <- arrange(ted, comments)
keeps <- c("title", "main_speaker", "views", "comments")
ten_talks <- subset(ten_talks, select = keeps)
last_10_talks <- ten_talks[0:10,]
last_10_talks

ten_talks <- arrange(ted, desc(comments))
ten_talks <- subset(ten_talks, select = keeps)
top_10_talks <- ten_talks[0:10,]
top_10_talks

As can be seen above, Richard Dawkins’ talk on Militant Atheism’ generated the greatest amount of discussion and opinions despite having significantly lesser views than Ken Robinson’s talk, which is second in the list. This raises some interesting questions.

Which talks tend to attract the largest amount of discussion?

To answer this question, we will define a new feature discussion quotient which is simply the ratio of the number of comments to the number of views. We will then check which talks have the largest discussion quotient.

ted$dis_quo <- ted$comments/ted$views
ten_talks <- arrange(ted, dis_quo)
keeps <- c("title", "main_speaker", "views", "comments", "dis_quo")
ten_talks <- subset(ten_talks, select = keeps)
last_10_talks <- ten_talks[0:10,]
last_10_talks

ten_talks <- arrange(ted, desc(dis_quo))
ten_talks <- subset(ten_talks, select = keeps)
top_10_talks <- ten_talks[0:10,]
top_10_talks

This analysis has actually raised extremely interesting insights. Half of the talks in the top 10 are on the lines of Faith and Religion. I suspect science and religion is still a very hotly debated topic even in the 21st century. We shall come back to this hypothesis in a later section.

The most discusses talk, though, is The Case for Same Sex Marriage (which has religious undertones). This is not that surprising considering the amount of debate the topic caused back in 2009 (the time the talk was filmed).

Analyzing TED talks by the month and the year

TED (especially TEDx) Talks tend to occur all throughout the year. Is there a hot month as far as TED is concerned? In other words, how are the talks distributed throughout the months since its inception? Let us find out.

ted$filming_month <- as.numeric(format(ted$film_date, format= "%m"))
ted$filming_year <- as.numeric(format(ted$film_date, format = "%Y"))
month_df <- as.data.frame(table(ted$filming_month))
colnames(month_df) <- c("Month", "Talks")
month_df$Month <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
#Turn your 'Month' column into a character vector
month_df$Month <- as.character(month_df$Month)
#Then turn it back into an ordered factor
month_df$Month <- factor(month_df$Month, levels=unique(month_df$Month))
p8 <- ggplot(data = month_df, aes(Month, Talks)) +
      geom_bar(position = "dodge", stat = "identity", color = "blue", fill="blue") +
      geom_text(aes(label = Talks), vjust = 1.6, color = "white", size = 3) +
      tilt_theme
p8

February is clearly the most popular month for TED Conferences whereas August and January are the least popular. February’s popularity is largely due to the fact that the official TED Conferences are held in February. Let us check the distribution for TEDx talks only.

tedx <- filter(ted, grepl("TEDx", ted$event, fixed = TRUE))
month_df <- as.data.frame(table(tedx$filming_month))
colnames(month_df) <- c("Month", "Talks")
month_df$Month <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
#Turn your 'Month' column into a character vector
month_df$Month <- as.character(month_df$Month)
#Then turn it back into an ordered factor
month_df$Month <- factor(month_df$Month, levels=unique(month_df$Month))
p9 <- ggplot(data = month_df, aes(Month, Talks)) +
      geom_bar(position = "dodge", stat = "identity", color = "red", fill="red") +
      geom_text(aes(label = Talks), vjust = 1.6, color = "white", size = 3) +
      tilt_theme
p9

As far as TEDx talks are concerned, November is the most popular month. However, we cannot take this result at face value as very few of the TEDx talks are actually uploaded to the TED website and therefore, it is entirely possible that the sample in our dataset is not at all representative of all TEDx talks. A slightly more accurate statement would be that the most popular TEDx talks take place the most in October and November.

The next question I’m interested in is the most popular days for conducting TED and TEDx conferences. The tools applied are very sensible to the procedure applied for months.

ted$film_weekday <- weekdays(as.Date(ted$film_date))
weekday_df <- as.data.frame(table(ted$film_weekday))
weekday_df

colnames(weekday_df) <- c("Weekday", "Talks")
weekday_df <- weekday_df[c(4,2,6,7,5,1,3),]
#Turn your 'Month' column into a character vector
weekday_df$Weekday <- as.character(weekday_df$Weekday)
#Then turn it back into an ordered factor
weekday_df$Weekday <- factor(weekday_df$Weekday, levels=unique(weekday_df$Weekday))
p10 <- ggplot(data = weekday_df, aes(factor(Weekday), Talks)) +
      geom_bar(position = "dodge", stat = "identity", color = "green", fill="green") +
      geom_text(aes(label = Talks), vjust = 1.6, color = "black", size = 3) +
      tilt_theme
p10

The distribution of days is almost a bell curve with Wednesday and Thursday being the most popular days and Sunday being the least popular. This is pretty interesting because I was of the opinion that most TED Conferences would happen sometime in the weekend.

Let us now visualize the number of TED talks through the years and check if our hunch that they have grown significantly is indeed true.

year_df <- as.data.frame(table(ted$filming_year))
year_df

colnames(year_df) <- c("Year", "Talks")
#Turn your 'Month' column into a character vector
#month_df$Month <- as.character(month_df$Month)
#Then turn it back into an ordered factor
#month_df$Month <- factor(month_df$Month, levels=unique(month_df$Month))
p11 <- ggplot(data = year_df, aes(Year, Talks, group = 1)) +
      geom_line(color = "blue") +
      geom_point() +
      geom_text(aes(label = Talks), vjust = 1.6, color = "black", size = 3) +
      tilt_theme
p11

Obervations - As expected, the number of TED Talks have gradually increased over the years since its inception in 1984. - There was a sharp increase in the number if talks in 2009. It might be interesting to know the reasons behind 2009 being the tipping point where the number of talks increased more than twofold. - The number of talks have been pretty much constant since 2009.

Finally, to put it all together, let us construct a heat map that shows us the number of talks by month and year. This will give us a good summary of the distribution of talks.

keeps <- c("filming_month", "filming_year")
heatmap_df <- ted %>% subset(select = keeps) %>% arrange(filming_year)
heatmap_df <- as.data.frame(table(heatmap_df))
heatmap_df$filming_month <- month.abb[heatmap_df$filming_month]
heatmap_df$filming_month <- as.character(heatmap_df$filming_month)
heatmap_df$filming_month <- factor(heatmap_df$filming_month, levels=unique(month_df$Month))
#heatmap_df 
ggplot(heatmap_df, aes(filming_year, factor(filming_month))) +
  geom_tile(aes(fill = Freq), color = "white") +
  geom_text(aes(fill = heatmap_df$Freq, label = heatmap_df$Freq)) +
  scale_fill_gradient2(low = "darkred", 
                       mid = "white", 
                       high = "midnightblue", 
                       midpoint = round(mean(heatmap_df$Freq))) +
  ylab("Year") +
  xlab("Months") +
  theme(legend.title = element_text(size = 10),
        legend.text = element_text(size = 12),
        plot.title = element_text(size=16),
        axis.title=element_text(size=14,face="bold"),
        axis.text.x = element_text(angle = 90, hjust = 1)) +
  labs(fill = "Freq")

Ignoring unknown aesthetics: fill

Ted Speakers

In this section, we will try and gain insight about all the amazing speakers who have managed to inspire millions of people through their talks on the TED Platform. The first question we shall ask in this section is who are the most popular TED Speakers. That is, which speakers have given the most number of TED Talks.

speaker_df <- as.data.frame(table(ted$main_speaker))
speaker_df <- arrange(speaker_df, desc(Freq))
speaker_df

Hans Rosling, the Swiss Health Professor is clearly the most popular TED Speaker, with more than 9 appearances on the TED Forum. Juan Enriquez comes a close second with 7 appearances. Rives and Marco Tempest have graced the TED platform 6 times.

Which occupation should you choose if you want to become a TED Speaker? Let us have a look what kind of people TED is most interested in inviting to its events.

occupation_df <- as.data.frame(table(ted$speaker_occupation))
occupation_df <- arrange(occupation_df, desc(Freq))
occupation_df <- head(occupation_df, 10)
colnames(occupation_df) <- c("Occupation", "Appearances")
occupation_df$Occupation <- as.character(occupation_df$Occupation)
occupation_df$Occupation <- factor(occupation_df$Occupation, levels=occupation_df$Occupation)
p12 <- ggplot(data = occupation_df, aes(factor(Occupation), Appearances)) +
      geom_bar(position = "dodge", stat = "identity", color = "cyan", fill="cyan") +
      geom_text(aes(label = Appearances), vjust = 1.6, color = "black", size = 3) +
      tilt_theme
p12

Observations - Writers are the most popular with more than 45 speakers identifying themselves as the aforementioned. - Artists and Designers come a distant second with around 35 speakers in each category. - This result must be taken with a pinch of salt as a considerable number of speakers identify themselves with multiple professions (for example, writer/entrepreneur).

Do some professions tend to attract a larger number of viewers? Do answer this question let us visualise the relationship between the top 10 most popular professions and the views that garnered in the form of a box plot.

top_occupation_views <- filter(ted, ted$speaker_occupation %in% occupation_df$Occupation)
p13 <- ggplot(top_occupation_views, aes(x=speaker_occupation, y=views)) + 
  geom_boxplot() +
  geom_jitter(shape=16, position=position_jitter(0.2)) +
  tilt_theme
p13 

On average, out of the top 10 most popular professions, Psychologists tend to garner the most views. Writers have the greatest range of views between the first and the third quartile..

Finally, let us check the number of talks which have had more than one speaker.

speaker_count <- table(ted$num_speaker)
speaker_count

   1    2    3    4    5 
2492   49    5    3    1 

Almost every talk has just one speaker. There are close to 50 talks where two people shared the stage. The maximum number of speakers to share a single stage was 5. I suspect this was a dance performance. Let’s have a look.

filter(ted, ted$num_speaker==5)

My hunch was correct. It is a talk titled A dance to honor Mother Earth by Jon Boogz and Lil Buck at the TED 2017 Conference.

TED Events Which TED Events tend to hold the most number of TED.com upload worthy events? We will try to answer that question in this section.

events_df <- ted %>% select(c("event")) %>% group_by("event")
events_df <- as.data.frame(table(events_df))
events_df <- arrange(events_df, desc(Freq))
events_df <- head(events_df, 10)
p14 <- ggplot(data = events_df, aes(event, Freq)) +
      geom_bar(position = "dodge", stat = "identity", color = "blue", fill="blue") +
      geom_text(aes(label = Freq), vjust = 1.6, color = "white", size = 3) +
      tilt_theme
p14

As expected, the official TED events held the major share of TED Talks published on the TED.com platform. TED2014 had the most number of talks followed by TED2009. There isn’t too much insight to be gained from this.

TED Languages One remarkable aspect of TED Talks is the sheer number of languages in which it is accessible. Let us perform some very basic data visualisation and descriptive statistics about languages at TED.

describe(ted$languages)

ted$languages 
       n  missing distinct     Info     Mean      Gmd      .05      .10      .25      .50      .75      .90      .95 
    2550        0       66    0.998    27.33    10.11        7       18       23       28       33       38       41 

lowest :  0  1  2  3  4, highest: 64 65 66 69 72

On average, a TED Talk is available in 27 different languages. The maximum number of languages a TED Talk is available in is a staggering 72. Let us check which talk this is.

filter(ted, ted$languages == 72)

The most translated TED Talk of all time is Matt Cutts’ Try Something New in 30 Days. The talk does have a very universal theme of exploration. The sheer number of languages it’s available in demands a little more inspection though as it has just over 8 million views, far fewer than the most popular TED Talks.

Finally, let us check if there is a correlation between the number of views and the number of languages a talk is availbale in. We would think that this should be the case since the talk is more accessible to a larger number of people but as Matt Cutts’ talk shows, it may not really be the case.

scatter2 <- qplot(languages, views, data=ted)  + 
         scale_y_continuous(limits=c(min(ted$views),max(ted$views))) + 
         scale_x_continuous(limits=c(min(ted$languages),max(ted$languages))) + 
         geom_rug(col=rgb(.5,0,0,alpha=.2))
scatter2

cor(ted$languages, ted$views)

[1] 0.3776231

The Pearson coefficient is 0.38 suggesting a medium correlation between the aforementioned quantities.

TED Themes In this section, we will try to find out the most popular themes in the TED conferences. Although TED started out as a conference about technology, entertainment and design, it has since diversified into virtually every field of study and walk of life. It will be interesting to see if this conference with Silicon Valley origins has a bias towards certain topics.

To answer this question, we need to wrangle our data in a way that it is suitable for analysis. More specifically, we need to split the related_tags list into separate rows.

perfect_tag <- function(x){
  x <- unlist(strsplit(x, "'"))
  val = x[2]
  for (i in 3:length(x))
    if (nchar(x[i]) >2)
      val <- c(val, x[i])
    return (val)
  
}
ted$processed_tags <-  lapply(ted$tags, perfect_tag)

processed_tags <- ted$processed_tags
length(processed_tags)

[1] 2550

processed_tags <- unlist(processed_tags, recursive=FALSE)
length(processed_tags)

[1] 19154

processed_tags <- as.data.frame(table(processed_tags))
processed_tags <- arrange(processed_tags, desc(Freq))
head(processed_tags, 10)

processed_tags$processed_tags <- as.character(processed_tags$processed_tags)
processed_tags$processed_tags <- factor(processed_tags$processed_tags, levels=processed_tags$processed_tags)
p15 <- ggplot(data = head(processed_tags, 10), aes(processed_tags, Freq)) +
      geom_bar(position = "dodge", stat = "identity", color = "blue", fill="blue") +
      geom_text(aes(label = Freq), vjust = 1.6, color = "white", size = 3) +
      tilt_theme
p15

As may have been expected, Technology is the most popular topic for talks. The other two original factions, Design and Entertainment, also make it to the list of top 10 themes. Science and Global Issues are the second and the third most popular themes respectively.

The next question I want to answer is the trends in the share of topics of TED Talks across the world. Has the demand for Technology talks increased? Do certain years have a disproportionate share of talks related to global issues? Let’s find out!

We will only be considering the top 7 themes, excluding TEDx and talks after 2009, the year when the number of TED Talks really peaked.

factor_fn <- function(x){
  return(factor(x, levels = x))
}
ted$processed_tags <- lapply(ted$processed_tags, unlist, recursive = FALSE)
ted$processed_tags <- lapply(ted$processed_tags, factor_fn)
rows_to_keep <- rep(TRUE, length(ted$processed_tags))
for (i in 1:length(ted$processed_tags)){
  if (any(unlist(ted$processed_tags[i]) %in% processed_tags$processed_tags[1:10])){
    rows_to_keep[i] <- TRUE} else {
    rows_to_keep[i] <- FALSE}
}

pop_theme_talks <- subset(pop_theme_talks, filming_year>2008)
pop_theme_talks <- pop_theme_talks[rows_to_keep,]

themes <- list(processed_tags$processed_tags[1:10])
themes

[[1]]
 [1] technology    science       global issues culture       TEDx          design        business      entertainment
 [9] health        innovation   
416 Levels: technology science global issues culture TEDx design business entertainment health innovation ... testing

colnames(pop_theme_talks)

 [1] "name"           "event"          "views"          "filming_month"  "filming_year"   "processed_tags"
 [7] "technology"     "science"        "gi"             "culture"        "tedx"           "design"        
[13] "business"       "et"             "health"         "inno"           "dummy"         

# drop columns
pop_theme_talks <- pop_theme_talks[, c("name", "event", "views", "filming_month", "filming_year", "processed_tags")]
pop_theme_talks

x <- unlist(pop_theme_talks$processed_tags[4])
toString(x[3])

[1] "global issues"

#tag <- "technology"
#tag <- "science"
#tag <- "global issues"
#tag <- "culture"
#tag <-  "TEDx"
#tag <- "design"
#tag <- "business"
#tag <-  "entertainment"
#tag <- "health"
#tag <- "innovation""
count_tag <- function(vec, tag){
  count <- 0
  x<- unlist(vec)
  for (i in 1:length(x)){
    if (toString(x[i]) == tag){
      count <- count+1
    }
  }
  return (count)
}

pop_theme_talks$technology <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "technology")
pop_theme_talks$science <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "science")
pop_theme_talks$gi <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "global issues")
pop_theme_talks$culture <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "culture")
pop_theme_talks$tedx <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "TEDx")
pop_theme_talks$design <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "design")
pop_theme_talks$business <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "business")
pop_theme_talks$et <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "entertainment")
pop_theme_talks$health <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "health")
pop_theme_talks$inno <- sapply(X = pop_theme_talks$processed_tags,FUN = count_tag, tag = "innovation")

tag1 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$technology)[,2])
tag2 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$science)[,2])
tag3 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$gi)[,2])
tag4 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$culture)[,2])
tag5 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$tedx)[,2])
tag6 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$design)[,2])
tag7 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$business)[,2])
tag8 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$et)[,2])
tag9 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$health)[,2])
tag10 <- as.data.frame(table(pop_theme_talks$filming_year, pop_theme_talks$inno)[,2])

tag_df <- cbind.data.frame(tag1, tag2, tag3, tag4, tag5, tag6, tag7, tag8, tag9, tag10)
#tag_df$filming_year <- as.numeric(rownames(tag_df))
tag_df <- as.data.frame(t(tag_df))
#colnames(tag_df) <- tag_df[1, ]
#tag_df<- tag_df[-1, ]
#tag_df$myfactor <- factor(row.names(tag_df))
tag_df

library(reshape2)
library (scales)

Attaching package: 'scales'

The following object is masked from 'package:readr':

    col_factor

tag_df$row <- seq_len(nrow(tag_df))
dat2 <- melt(tag_df, id.vars = "row")
dat2$tag <- rep(c("technology","science","global issues", "culture", "TEDx", "design", "business", "entertainment",
                  "health","innovation"), 9)
p16 <- ggplot(dat2, aes(x=variable, y=value, fill=tag)) + 
  geom_bar(stat="identity", position = "fill") +
  xlab("\nYear") +
  ylab("Percentage\n") +
  scale_y_continuous(labels = percent_format()) +
  tilt_theme
p16

head(dat2)

p17 <- ggplot(dat2, aes(x=variable, y=value, colour=tag)) + 
  geom_point(aes(x=variable, y=value, color=tag, size = tag)) +
  tilt_theme
p17

The proportion of technology talks has steadily increased over the years with a slight dip in 2010. This is understandable considering the boom of technologies such as blockchain, deep learning and augmented reality capturing people’s imagination.

Talks on culture have witnessed a dip, decreasing steadily starting 2013. The share of culture talks has been the least in 2017. Entertainment talks also seem to have witnessed a slight decline in popularity since 2009.

Talk Duration and Word Counts

In this section, we will perform analysis on the length of TED Talks. TED is famous for imposing a very strict time limit of 18 minutes. Although this is the suggested limit, there have been talks as short as 2 minutes and some have stretched to as long as 24 minutes. Let us get an idea of the distribution of TED Talk durations.

ted$duration <- ted$duration /60
describe(ted$duration)

ted$duration 
       n  missing distinct     Info     Mean      Gmd      .05      .10      .25      .50      .75      .90      .95 
    2550        0     1083        1    13.78    6.466    4.491    5.833    9.617   14.133   17.446   19.833   21.759 

lowest :  2.250000  2.333333  2.350000  2.383333  2.550000, highest: 59.550000 60.133333 65.916667 76.450000 87.600000

TED Talks, on average are 13.7 minutes long. I find this statistic surprising because TED Talks are often synonymous with 18 minutes and the average is a good 3 minutes shorter than that.

The shortest TED Talk on record is 2.25 minutes long whereas the longest talk is 87.6 minutes long. I’m pretty sure the longest talk was not actually a TED Talk. Let us look at both the shortest and the longest talk

filter(ted, ted$duration == 2.25)

filter(ted, ted$duration == 2.25)

The shortest talk was at TED2007 titled The ancestor of language by Murray Gell-Mann. The longest talk on TED.com, as we had guessed, is not a TED Talk at all. Rather, it was a talk titled Parrots, the universe and everything delivered by Douglas Adams at the University of California in 2001.

Let us now check for any correlation between the popularity and the duration of a TED Talk. To make sure we only include TED Talks, we will consider only those talks which have a duration less than 25 minutes

scatter3 <- qplot(duration, views, data=filter(ted, ted$duration < 25))  + 
         scale_y_continuous(limits=c(min(ted$views),max(ted$views))) + 
         scale_x_continuous(limits=c(min(ted$duration),25)) + 
         geom_rug(col=rgb(.5,0,0,alpha=.2))
scatter3

z <- filter(ted, ted$duration <25)
vd_cor <- cor(z$views, z$duration)
print("Correlation between Views and duration")

[1] "Correlation between Views and duration"

vd_cor

[1] 0.07582871

There seems to be almost no correlation between these two quantities. This strongly suggests that there is no tangible correlation between the length and the popularity of a TED Talk. Content is king at TED.

Next, we look at transcripts to get an idea of word count. For this, we introduce our second dataset, the one which contains all transcripts.

head(transcript)

dim(transcript)

[1] 2467    2

It seems that we have data available for 2467 talks. Let us perform a join of the two dataframes on the url feature to include word counts for every talk.

df_ted <- left_join(ted, transcript, by = "url")
head(df_ted)

library(stringr)
df_ted$transcript <- replace(df_ted$transcript,is.na(df_ted$transcript),' ')
count_words <- function(vec){
  return (length(unlist((str_extract_all(tolower(vec), '\\w+')))))
}
df_ted$word_count <- sapply(df_ted$transcript, count_words)

describe(df_ted$word_count)

df_ted$word_count 
       n  missing distinct     Info     Mean      Gmd      .05      .10      .25      .50      .75      .90      .95 
    2553        0     1799        1     2052     1179    331.6    681.6   1287.0   2060.0   2785.0   3322.2   3655.2 

lowest :    0    2    3    4    7, highest: 6023 6324 6723 8278 9418

We can see that the average TED Talk has around 1971 words and there is a significantly large standard deviation of a 1009 words. The longest talk is more than 9044 words in length.

Like duration, there shouldn’t be any correlation between number of words and views. We will proceed to look at a more interesting statstic: the number of words per minute.

df_ted$wpm <- df_ted$word_count/df_ted$duration
describe(df_ted$wpm)

df_ted$wpm 
       n  missing distinct     Info     Mean      Gmd      .05      .10      .25      .50      .75      .90      .95 
    2553        0     2453        1      148    40.77     55.0    110.1    136.1    154.7    172.1    187.3    196.8 

lowest :   0.0000000   0.2033898   0.4278075   0.6185567   0.6469003
highest: 224.5989305 227.9180887 230.8424182 233.7215190 257.8378378

The average TED Speaker enunciates 142 words per minute. The fastest talker spoke a staggering 247 words a minute which is much higher than the average of 125-150 words per minute in English. Let us see who this is!

filter(df_ted, df_ted$wpm > 245)

Finally, in this section, I’d like to see if there is any correlation between words per minute and popularity.

scatter4 <- qplot(wpm, views, data=filter(df_ted, df_ted$duration<25))  + 
         scale_y_continuous(limits=c(min(df_ted$views),max(df_ted$views))) + 
         scale_x_continuous(limits=c(min(df_ted$wpm),max(df_ted$wpm))) + 
         geom_rug(col=rgb(.5,0,0,alpha=.2))
scatter4

z <- filter(df_ted, df_ted$duration<25)
vd_cor <- cor(z$views, z$wpm)
print("Correlation between Views and words per minute")

[1] "Correlation between Views and words per minute"

vd_cor

[1] 0.07340039

Again, there is practically no correlation. If you are going to give a TED Talk, you probably shouldn’t worry if you’re speaking a little faster or a little slower than usual.

TED Ratings TED allows its users to rate a particular talk on a variety of metrics. We therefore have data on how many people found a particular talk funny, inspiring, creative and a myriad of other verbs. Let us inspect how this ratings dictionary actually looks like.

rating_to_list <- function(vec){
x <- str_extract_all(vec, "\\w+")
x <- str_replace_all(x, "id", " ")
x <- str_replace_all(x, "name", " ")
x <- str_replace_all(x, "count", " ")
x <- unlist(str_extract_all(x, "\\w+"))
x <- setdiff(x, "c")
return (x)
}

ted$rat_list <- lapply(ted$ratings, rating_to_list)

unlist(ted$rat_list[1])

 [1] "7"            "Funny"        "19645"        "1"            "Beautiful"    "4573"         "9"           
 [8] "Ingenious"    "6073"         "3"            "Courageous"   "3253"         "11"           "Longwinded"  
[15] "387"          "2"            "Confusing"    "242"          "8"            "Informative"  "7346"        
[22] "22"           "Fascinating"  "10581"        "21"           "Unconvincing" "300"          "24"          
[29] "Persuasive"   "10704"        "23"           "Jaw"          "dropping"     "4439"         "25"          
[36] "OK"           "1174"         "26"           "Obnoxious"    "209"          "10"           "Inspiring"   
[43] "24924"       

which(unlist(ted$rat_list[1]) == "Beautiful")

[1] 5

unlist(ted$rat_list[1])[which(unlist(ted$rat_list[1]) == "Beautiful")+1]

[1] "4573"

In this section, I want to find out which talks were rated the funniest, the most beautiful, the most confusing and most jaw dropping of all time. The rest is left to the reader to explore. We now need to define three extra features to accomplish this task.

find_rating_count <- function(vec, rat_tag){
  count <- unlist(vec)[which(unlist(vec) == rat_tag) +1]
  return (count)
}

ted$funny <- sapply(ted$rat_list, find_rating_count, rat_tag = "Funny")
ted$funny <- replace(ted$funny,is.na(ted$funny),"0")
ted$funny <- as.numeric(ted$funny)

NAs introduced by coercion

ted$funny <- replace(ted$funny,is.na(ted$funny),0)
ted$beautiful <- sapply(ted$rat_list, find_rating_count, rat_tag = "Beautiful")
ted$beautiful <- replace(ted$beautiful,is.na(ted$beautiful),"0")
ted$beautiful <- as.numeric(ted$beautiful)

NAs introduced by coercion

ted$beautiful <- replace(ted$beautiful,is.na(ted$beautiful),0)
ted$confusing <- sapply(ted$rat_list, find_rating_count, rat_tag = "Confusing")
ted$confusing <- replace(ted$confusing,is.na(ted$confusing),"0")
ted$confusing <- as.numeric(ted$confusing)

NAs introduced by coercion

ted$confusing <- replace(ted$confusing,is.na(ted$confusing),0)
ted$jawdropping <- sapply(ted$rat_list, find_rating_count, rat_tag = "dropping")
ted$jawdropping <- replace(ted$jawdropping,is.na(ted$jawdropping),"0")
ted$jawdropping <- as.numeric(ted$jawdropping)

NAs introduced by coercion

ted$jawdropping <- replace(ted$jawdropping,is.na(ted$jawdropping),0)

head(ted)

Funniest talk of all time

ten_talks <- arrange(ted, funny)
keeps <- c("title", "main_speaker", "views", "speaker_occupation", "film_date")
ten_talks <- subset(ten_talks, select = c("title", "main_speaker", "views", "funny", "film_date"))
last_10_talks <- ten_talks[0:10,]
last_10_talks

ten_talks <- arrange(ted, desc(funny))
ten_talks <- subset(ten_talks, select = c("title", "main_speaker", "views", "funny", "film_date"))
top_10_talks <- ten_talks[0:10,]
top_10_talks

Most Beautiful Talks of all time

ten_talks <- arrange(ted, desc(beautiful))
ten_talks <- subset(ten_talks, select = c("title", "main_speaker", "views", "beautiful", "film_date"))
top_10_talks <- ten_talks[0:10,]
top_10_talks

Most Jaw Dropping Talks of all time

ten_talks <- arrange(ted, desc(jawdropping))
ten_talks <- subset(ten_talks, select = c("title", "main_speaker", "views", "jawdropping", "film_date"))
top_10_talks <- ten_talks[0:10,]
top_10_talks

Most Confusing Talks of all time

ten_talks <- arrange(ted, desc(confusing))
ten_talks <- subset(ten_talks, select = c("title", "main_speaker", "views", "confusing", "film_date"))
top_10_talks <- ten_talks[0:10,]
top_10_talks